perm filename EXPAND.F4[EMS,LCS] blob
sn#722188 filedate 1983-08-02 generic text, type T, neo UTF8
C EXPAND.F4 ***** LOAD WITH READRW.F4, READX.F4
INTEGER TOTL,TOTOUT
COMMON /XYZ/X(650),Y(650),Z(650)
COMMON /OUTL/OX(650),OY(650),OZ(650)
COMMON /S/SL(650),P(650)
COMMON /CCC/G,CCX,CCY,DDX,DDY,SZF,DSZ
C G=DISTORTAION FACTOR, CCX,CCY=DISPLACEMENT OF CENTER
C DDX,DDY=DISPLACEMENT OF ENTIRE DRAWING, SZF=DRAWING SIZE FACTOR
COMMON TOTL,CX,CY,LF,RT,TOP,BOT,TOTOUT,IB
COMMON/I/ I(3000)
1 CALL DPYSET(1,I,3000)
TOTL=0
DDY=0
DDX=0
TOTOUT=0
CALL READRW
C READ IN THE DRAWING
IB=1
DDX=100
CALL DPY(X,Y,Z,TOTL)
2 CALL RDOUTL
C READ IN THE OUTLINE
IB=1
IF(DDY.NE.0)GO TO 6
C JUMP IF DOING DRAWING TRANSITION.
CALL DPY(OX,OY,OZ,TOTOUT)
3 CALL MAKNEW
C EXPAND THE DRAWING
7 IB=6
C MAKE EXPANDED IMAGE BRIGHTER (IB=6)
4 CALL DPY(X,Y,Z,TOTL)
5 CALL SAVIT
GO TO 1
6 CALL TRNSIT
GO TO 7
END
SUBROUTINE MAKNEW
INTEGER TOTL,TOTOUT,HIT
COMMON /XYZ/X(650),Y(650),Z(650)
COMMON /OUTL/OX(650),OY(650),OZ(650)
COMMON /S/SL(650),P(650)
COMMON /CCC/G
COMMON TOTL,CX,CY,LF,RT,TOP,BOT,TOTOUT
10 FORMAT(' CX=',F6.3,' CY=',F6.3)
11 FORMAT(' X,Y,Z = '2F8.3,F3.0)
TYPE 10,CX,CY
CC DO 12 K=1,TOTL
CC12 TYPE 11,X(K),Y(K),Z(K)
K=1
1 DO 2 J=2,TOTOUT
IF(HIT(J,OX,OY,K,A,B).LT.0)GO TO 2
C NOW RESET COORDS.
X(K)=CX+(A-CX)*P(K)*G
Y(K)=CY+(B-CY)*P(K)*G
CX X(K)=X(K)+(A-X(K))*G*P(K)
C Y(K)=Y(K)+(B-Y(K))*G*P(K)
C P = % OF LONGEST LINE FROM CENTER TO A POINT.
CC13 TYPE 11,X(K),Y(K),Z(K)
IF(K.EQ.TOTL)RETURN
K=K+1
GO TO 1
2 CONTINUE
END
INTEGER FUNCTION HIT(J,OX,OY,K,A,B)
DIMENSION OX(1),OY(1)
INTEGER TOTL,TOTOUT,HIT
COMMON /XYZ/X(650),Y(650),Z(650)
CC COMMON /OUTL/OX(650),OY(650)
COMMON /S/SL(650),P(650)
COMMON TOTL,CX,CY,LF,RT,TOP,BOT
RX=OX(J-1)
SX=OX(J)
RY=OY(J-1)
SY=OY(J)
IF(RX.LE.SX)GO TO 2
SX=RX
RX=OX(J)
SY=RY
RY=OY(J)
2 TY=RY
UY=SY
IF(TY.LE.UY)GO TO 4
UY=RY
TY=SY
C TY=BOTTOM, UY =TOP, RX=LEFT, SX=RIGHT
4 C=SX-RX
IF(C.EQ.0)GO TO 1
SS=(SY-RY)/C
C SLOPE OF THIS LINE
A=(RY-CY-SS*RX+SL(K)*CX)/(SL(K)-SS)
B=SS*(A-RX)+RY
5 HIT=-1
C A MISS
IF(A.LT.RX.OR.A.GT.SX)RETURN
IF(B.LT.TY.OR.B.GT.UY)RETURN
IF(Y(K).LT.CY.AND.CY.LT.B)RETURN
IF(Y(K).GT.CY.AND.CY.GT.B)RETURN
IF(X(K).LT.CX.AND.CX.LT.A)RETURN
IF(X(K).GT.CX.AND.CX.GT.A)RETURN
HIT=0
C A HIT
RETURN
1 B=SL(K)*(SX-CX)+CY
A=RX
GO TO 5
END
SUBROUTINE DPY(X,Y,Z,L)
INTEGER TOTL,TOTOUT
DIMENSION X(1),Y(1),Z(1)
COMMON TOTL,CX,CY,LF,RT,TOP,BOT,TOTOUT,IB
COMMON /CCC/G,CCX,CCY,DDX,DDY,SZF,DSZ
C MAKE EXPANDED IMAGE BRIGHTER
CALL DPYBRT(IB)
Q=0
IF(IB.GT.4)Q=500
10 DO 1 K=1,L
M=DSZ*X(K)+.5-DDX
N=DSZ*Y(K)+.5-Q
IF(Z(K).NE.0)GO TO 2
CALL AVECT(M,N)
GO TO 1
2 CALL AIVECT(M,N)
1 CONTINUE
CALL DPYOUT(1)
END
SUBROUTINE SAVIT
INTEGER TOTL
COMMON /XYZ/X(650),Y(650),Z(650)
COMMON TOTL,CX,CY,LF,RT,TOP,BOT,TOTOUT,IB
COMMON/NM2/NM2
CALL IO(3)
IF(NM2.EQ.' ')RETURN
DO 1 K=1,TOTL
A=X(K)
B=.5
IF(A.LT.0)B=-B
L=A+B
A=Y(K)
B=.5
IF(A.LT.0)B=-B
M=A+B
N=Z(K)
1 WRITE(20,2)K,L,M,N
END FILE 20
2 FORMAT(1I4,2I5,1I3)
END
SUBROUTINE TRNSIT
INTEGER TOTL,TOTOUT
COMMON /XYZ/X(650),Y(650),Z(650)
COMMON /OUTL/OX(650),OY(650),OZ(650)
COMMON TOTL,CX,CY,LF,RT,TOP,BOT,TOTOUT,IB
COMMON /CCC/G,CCX,CCY,DDX,DDY,SZF,DSZ
DDX=600
CALL DPY(OX,OY,OZ,TOTOUT)
DO 1 K=1,TOTL
X(K)=X(K)-(X(K)-OX(K))*CCX
1 Y(K)=Y(K)-(Y(K)-OY(K))*CCY
DDX=350
END